home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #324 (1994-04)(Rhein-Sieg-Soft).zip / Franz PD Disk #324 (1994-04)(Rhein-Sieg-Soft).adf / VideoText3.5 / source / i2c_serial.p < prev    next >
Text File  |  1994-04-01  |  8KB  |  199 lines
  1. UNIT i2c_serial; {$project vt}
  2. { Steuert I²C-Bus Interface am seriellen Port des Amiga }
  3.  
  4. INTERFACE;
  5.  
  6. VAR i2c_status, busdelay: Integer;
  7. PROCEDURE i2cbusIO(busaddr: byte; buffer: Ptr; data: Integer);
  8. PROCEDURE setregister(addr,reg,value: Byte);
  9. FUNCTION getregister(addr,reg: Byte): Byte;
  10.  
  11. { ---------------------------------------------------------------------- }
  12.  
  13. IMPLEMENTATION;
  14.  
  15. {$opt q,s+,i+ - keine Laufzeitprüfungen außer Stack und Feldindizes }
  16. {$incl "exec.lib", "intuition.lib", "hardware/cia.h", "resources/misc.h" }
  17.  
  18. CONST CLKHI =  CIAF_COMRTS; CLKLO =  NOT CLKHI;  CLKIN =  CIAF_COMCTS;
  19.       DATAHI = CIAF_COMDTR; DATALO = NOT DATAHI; DATAIN = CIAF_COMCD;
  20.  
  21. VAR owner1,owner2: Ptr;
  22.     ciab: ^CIA;
  23.  
  24. PROCEDURE getbus;
  25. { Zugriff auf Hardware sichern und CIA-Register initialisieren }
  26. VAR rache: Boolean;
  27.     zeile1,zeile2: String[80];
  28.     buf: String[200];
  29.     xpos, l1, l2: Integer;
  30. CONST ich = 'I²C-bus';
  31. BEGIN
  32.   MiscBase := OpenResource(MISCNAME);
  33.   { Resource braucht *nicht* wieder geschlossen zu werden! }
  34.   owner1 := ptr(AllocMiscResource(MR_SERIALBITS, ich));
  35.   owner2 := ptr(AllocMiscResource(MR_SERIALPORT, ich));
  36.   IF (owner1 <> Nil) OR (owner2 <> Nil) THEN BEGIN
  37.     { mit Alert nachfragen, etwas aufwendig }
  38.     zeile1 := 'Serial ressources are owned by "';
  39.     IF owner1<>Nil THEN zeile1 := zeile1 + copy(str(owner1),1,16);
  40.     zeile1 := zeile1 + '"/"';
  41.     IF owner2<>Nil THEN zeile1 := zeile1 + copy(str(owner2),1,16);
  42.     zeile1 := zeile1 + '"!';
  43.     l1 := length(zeile1);
  44.     zeile2 := 'LEFT BUTTON = NO, THEY''RE MINE!      '
  45.              +'                RIGHT BUTTON = THANKS';
  46.     l2 := length(zeile2);
  47.     buf := '   '+zeile1+'     '+zeile2;
  48.     xpos := 320 - 4*l1;
  49.     buf[1] := chr(Hi(xpos)); buf[2] := chr(Lo(xpos));
  50.     buf[3] := chr(16);
  51.     buf[l1+4] := chr(0); buf [l1+5] := chr(1); { Fortsetzungsbyte }
  52.     xpos := 320 - 4*l2;
  53.     buf[l1+6] := chr(Hi(xpos)); buf[l1+7] := chr(Lo(xpos));
  54.     buf[l1+8] := chr(32);
  55.     buf [l1+l2+10] := chr(0); { Ende }
  56.     rache := DisplayAlert(RECOVERY_ALERT,buf,44);
  57.     IF rache THEN BEGIN
  58.       owner1 := Nil;
  59.       owner2 := Nil;
  60.     END;
  61.   END;
  62.   IF (owner1 <> Nil) OR (owner2<>Nil) THEN
  63.     Error('Cannot allocate serial port!');
  64.   ciab := ptr(Adr_ciab);
  65.   { CTS- und DCD-Bit auf Eingang, RTS und DTR auf Ausgang }
  66.   ciab^.ciaddra := (ciab^.ciaddra AND NOT (CIAF_COMCD OR CIAF_COMCTS))
  67.     OR CIAF_COMRTS OR CIAF_COMDTR;
  68. END;
  69.  
  70. PROCEDURE releasebus;
  71. { Ressourcen zurückgeben, sofern sie nicht jemand anders gehörten. }
  72. { (Man kann nämlich auch fremde Ressourcen freigeben - sehr 'sinnvoll'!) }
  73. BEGIN
  74.   IF owner1 = Nil THEN FreeMiscResource(MR_SERIALBITS);
  75.   IF owner2 = Nil THEN FreeMiscResource(MR_SERIALPORT);
  76. END;
  77.  
  78. FUNCTION s_i2cbusIO(busaddr: byte; buffer: Ptr; data: Integer;
  79.                     busdelay: Integer): Integer; IMPORT;
  80. {$ulink "vt/s_i2cbusIO.o" }
  81. { Ich kann leider nicht direkt die Routine "i2cbusIO" importieren, da dann }
  82. { das Unit diesen Bezeichner sowohl importieren als auch exportieren müßte. }
  83. { Und das macht nicht viel Sinn, oder? }
  84.  
  85. {$opt q,s+}
  86. PROCEDURE i2cbusIO{(busaddr: byte; buffer: Ptr; data: Integer)};
  87. { Startet den I²C-Bus und spricht den Chip mit Nr. <busaddr> an. Ist <data> }
  88. { positiv, werden <data> Bytes ab Adresse <buffer> über den Bus abgeschickt, }
  89. { sonst werden <-data> Bytes vom Bus geholt und ab Adresse <buffer> im }
  90. { Speicher abgelegt. Anschließend wird der I²C-Bus wieder gestoppt. }
  91. { Setzt als zusätzliche Rückmeldung die globale Variable "i2c_status": 0 bei }
  92. { fehlerfreier Übertragung, 1 bei unquittierten Daten und 2, wenn überhaupt }
  93. { keine Reaktion vom Bus kommt. }
  94. { Anmerkungen: }
  95. { 1. Das unterste Bit in <busaddr> wird ignoriert und entsprechend der }
  96. {   I²C-Bus-Konvention auf 0 für Schreiben bzw. 1 für Lesen gesetzt. }
  97. { 2. Mehr Bytes zum Lesen anzufordern, als der bereitgestellte Puffer fassen }
  98. {   kann, ist ein Fehler, der nicht erkannt wird und wahrscheinlich mit einem }
  99. {   GURU endet. }
  100. { Die Variable <busdelay> steuert eine Zählschleife (sic!) und sollte auf }
  101. { normalen Amigas 0 sein. Für beschleunigte Amigas sollte hier ein geeigneter }
  102. { Wert den Bus auf die erlaubten 100 kHz bremsen können. }
  103. BEGIN
  104.   i2c_status := s_i2cbusIO(busaddr,buffer,data,busdelay);
  105. END;
  106. {VAR buf: ^Array[1..MAXINT] of byte;
  107.     i,bit,send,recv,l: integer;
  108.     x: byte;
  109.     myCIAport: Byte ABSOLUTE $BFD000;
  110. LABEL panic;
  111. BEGIN
  112.   i2c_status := 0;
  113.   buf := buffer;
  114.   send := 0; recv := 0;
  115.   IF data>0 THEN  send := data  else  recv := -data;
  116.   busaddr := busaddr AND $FE;  IF recv>0 THEN busaddr := busaddr OR 1;
  117.   { Bus starten: Protokollverletzung mit H->L }
  118.   myCIAport := myCIAport OR CLKHI OR DATAHI; for l := 1 to busdelay DO;
  119.   myCIAport := myCIAport AND DATALO;  for l := 1 to busdelay DO;
  120.   myCIAport := myCIAport AND CLKLO;  for l := 1 to busdelay DO;
  121.   { Daten senden, mindestens ein Byte für die Adressierung: }
  122.   for i := 0 to send DO BEGIN
  123.     IF i=0 THEN  x := busaddr  else  x := buf^[i];
  124.     for bit := 7 downto 0 DO BEGIN
  125.       IF ((x shr bit) AND $01) = 0 THEN
  126.         myCIAport := myCIAport AND DATALO
  127.       else
  128.         myCIAport := myCIAport OR DATAHI;
  129.       myCIAport := myCIAport OR CLKHI;  for l := 1 to busdelay DO;
  130.       myCIAport := myCIAport AND CLKLO;  for l := 1 to busdelay DO;
  131.     END;
  132.     { Quittierungsbit lesen }
  133.     myCIAport := myCIAport OR DATAHI;
  134.     myCIAport := myCIAport OR CLKHI;  for l := 1 to busdelay DO;
  135.     IF (myCIAport AND DATAIN)<>0 THEN BEGIN
  136.       { Quittierungsbit = H: bitte keine weiteren Daten, Abbruch. }
  137.       { Falls das schon beim Senden der Adresse auftritt (i=0), hat überhaupt }
  138.       { kein Busteilnehmer zugehört: falsche Adresse oder Hardwareproblem. }
  139.       IF i=0 THEN  i2c_status := 2  else  i2c_status := 1;
  140.       GOTO panic;
  141.     END;
  142.     myCIAport := myCIAport AND CLKLO;  for l := 1 to busdelay DO;
  143.   END;
  144.   { Daten empfangen, sofern verlangt: }
  145.   for i := 1 to recv DO BEGIN
  146.     myCIAport := myCIAport OR DATAHI; { sonst liest man nur das eigene LO! }
  147.     x := 0;
  148.     for bit := 7 downto 0 DO BEGIN
  149.       x := x shl 1;
  150.       myCIAport := myCIAport OR CLKHI;  for l := 1 to busdelay DO;
  151.       IF (myCIAport AND DATAIN)<>0 THEN
  152.         Inc(x);
  153.       myCIAport := myCIAport AND CLKLO;  for l := 1 to busdelay DO;
  154.     END;
  155.     { Quittierungsbit senden }
  156.     IF i=recv THEN    { letztes Byte mit HI quittieren, sonst LO }
  157.       myCIAport := myCIAport OR DATAHI
  158.     else
  159.       myCIAport := myCIAport AND DATALO;
  160.     myCIAport := myCIAport OR CLKHI;  for l := 1 to busdelay DO;
  161.     myCIAport := myCIAport AND CLKLO;  for l := 1 to busdelay DO;
  162.     buf^[i] := x;
  163.   END;
  164. panic:
  165.   { Bus stoppen: Protokollverletzung mit L->H }
  166.   myCIAport := myCIAport AND CLKLO;  for l := 1 to busdelay DO;
  167.   myCIAport := myCIAport AND DATALO;  for l := 1 to busdelay DO;
  168.   myCIAport := myCIAport OR CLKHI;  for l := 1 to busdelay DO;
  169.   myCIAport := myCIAport OR DATAHI;
  170. END; }
  171. {$opt i+}
  172.  
  173. PROCEDURE setregister{(addr,reg,value: Byte)};
  174. { Häufig benötigter Vorgang: ein einzelnes Register am I²C-Bus beschreiben. }
  175. VAR bytes: array[1..2] of Byte;
  176. BEGIN
  177.   bytes[1] := reg; bytes[2] := value;
  178.   i2cbusIO(addr,^bytes,2);
  179. END;
  180.  
  181. FUNCTION getregister{(addr,reg: byte): Byte};
  182. { Etwas umständlicher, wird dafür auch seltener benötigt: ein einzelnes }
  183. { Register auslesen. NICHT schleifenweise aufrufen, um mehrere Bytes zu }
  184. { lesen! Das läßt sich direkt über i2cbusIO() eleganter regeln! }
  185. VAR result: Byte;
  186. BEGIN
  187.   i2cbusIO(addr,^reg,1);
  188.   i2cbusIO(addr,^result,-1);
  189.   getregister := result;
  190. END;
  191.  
  192. BEGIN  { Initialisierungsteil }
  193.   busdelay := 0;
  194.   OpenLib(IntuitionBase,'intuition.library',0)
  195.   AddExitServer(releasebus); getbus;
  196. END.
  197.  
  198.  
  199.